The following dataset is de-identified and already hosted on Github. The data come from one of my recent publications (Experiment 1; Miller, Gross, & Unsworth, 2019). In this paper, pupil dilation was used as an online indicator of the intensity of attention to determine whether variation in attention at encoding relates to individual differences in working memory capacity (WMC) and long-term memory (LTM) performance. Participants (N = 138) completed a battery of complex span working memory tasks, followed by a delayed free recall task while pupil dilation was simultaneously recorded.

data <- import(here("data", "DeIntentifiedJML2019Data_Exp1.sav"),
               setclass = "tibble") %>% 
  characterize() %>%
  janitor::clean_names()
# Select variables of interest for pupil data
pupil_data <- data %>%
  select(-sp1_acc:-symspan, 
         -ineffective:-recency_recall,
         -baseline_pupil_mean:-tepr_recency)

# Cam's efficient method to rename bin/word variables
# E.g., data currently reads ebin1w1pt4_mean
# I just want the variable to read bin1w1
pupil_data %<>%
  rename_at(
    vars(starts_with("ebin")),
    funs(
      paste(
        str_extract(., "w\\d{1,2}"),
        "_",
        str_extract(., "bin\\d{1,2}"),
        sep = "")))

Please note that for the following figures, I specified dimensions appropriate for a knitted html document. Also, just a heads up that it will probably take at least 5 minutes to generate the html because of the animated plots!

Plot 1

Here I plot changes in pupil diameter across the 3 second study/encoding phase for each word (i.e., bin).

  • Fig. 4 in Miller, Gross, & Unsworth (2019).
    • Identification of the intended audience: Scientific community
    • The intended message to be communicated: When instructed to study a list of words, pupil diameter increases throughout the study phase for each word. This increase in pupil dilation is believed to reflect an increase in the amount of attentional effort devoted to a given item.
# Tidy data:
plot1_data <- pupil_data %>%
  gather(key = word_bin, value = TEPR, w1_bin1:w10_bin15) %>%
  separate(word_bin, c("word", "bin"), sep = "_") %>%
  mutate(word = parse_number(word),
         bin = parse_number(bin)) %>%
  arrange(subject)

#glimpse(plot1_data)
plot1 <- plot1_data %>%
  group_by(bin) %>%
  summarise(mean_TEPR = mean(TEPR, na.rm = TRUE),
            se_TEPR = sundry::se(TEPR))

# This just makes the line begin at x = 0 and y = 0
plot1 <- rbind(plot1, "1st" = c(0, 0, 0)) 

# I want to model uncertainty with bootstrapping:
row_samps <- rerun(100,
      sample(seq_len(nrow(plot1)), 
             nrow(plot1), 
             replace = TRUE))

# Extracting samples
d_samps <- map_df(row_samps, ~plot1[., ], .id = "sample")

# Plotting both data sources (my data and hypothetical/bootstrapped data)
plot1 <- ggplot(plot1, aes(x = bin, y = mean_TEPR)) +
    stat_smooth(aes(group = sample),
              data = d_samps,
              geom = "line",
              color = "#2DDADA",
              fullrange = TRUE,
              size = 0.1) +
    theme_minimal() +
    # Bold title and axes; left-align caption
    theme(axis.title = element_text(face = "bold"),
          plot.title = element_text(face = "bold"),
          plot.caption = element_text(hjust = 0)) +
    # Change labels
    labs(caption = "Figure 1. Task evoked pupillary response across the 3 second study (encoding) phase for each word",
           y = "Mean Pupil Diameter (mm)",
           x = "Time (ms)") +
    # Relabel x axis values to make more sense to reader
    scale_x_continuous(breaks = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 
                                  9, 10, 11, 12, 13, 14, 15),
                       labels = c("0", "200", "400", "600", "800", "1,000", 
                                  "1,200", "1,400", "1,600", "1,800", "2,000", 
                                  "2,200", "2,400", "2,600", "2,800", "3,000"),
                       limits = c(0, NA)) +
    # Add text specifying when stimuli appear onscreen
    geom_text(y = 0.04,
              x = 1.4,
              color = "gray80",
              label = "      To-be-remembered
              word appears onscreen", size = 3, fontface = 2) +
    # Add dotted vertical line at x = 0
    geom_vline(aes(xintercept = 0),
               color = "gray80", 
               lty = "dashed")

# Creating my own theme
bbg_darktheme <- theme(panel.grid.major = element_line(colour = "gray20"), 
                   panel.grid.minor = element_line(colour = "gray20"), 
                   axis.text = element_text(colour = "gray80"), 
                   axis.text.x = element_text(colour = "gray80"), 
                   axis.text.y = element_text(colour = "gray80"),
                   axis.title = element_text(colour = "gray80", face = "bold"),
                   legend.text = element_text(colour = "gray80"), 
                   legend.title = element_text(colour = "gray80"), 
                   plot.subtitle = element_text(colour = "gray80"),
                   strip.text = element_text(colour = "gray80", face = "bold"),
                   panel.background = element_rect(fill = "gray10"),                     
                   plot.background = element_rect(fill = "gray10"), 
                   legend.background = element_rect(fill = NA, color = NA), 
                   plot.margin = margin(10, 10, b = 20, 10),
                   plot.caption = element_text(colour = "gray80", vjust = 1), 
                   plot.title = element_text(colour = "gray80", face = "bold"))

# Apply my theme to plot
plot1 + bbg_darktheme

Plot 2

Here I plot pupil diameter as a function of serial position for high WMC (n = 33), medium WMC (n = 69) and low WMC (n = 31) individuals.

  • Fig. 5 in Miller, Gross, & Unsworth (2019)
    • Identification of the intended audience: Scientific community
    • The intended message to be communicated: Different patterns of pupil dilation across serial positions emerge based on one’s working memory capacity (WMC). Namely, for high WMC individuals (n = 33), pupil diameter increases as each new word is introduced during the learning phase of the task. Alternatively, for low WMC individuals (n = 31), pupil diameter decreases as each new word is introducted during learning.
#Reordering factor levels for legend
plot1_data$span_group <- factor(plot1_data$span_group, 
                                levels = c("Low", "Medium", "High"))

plot2data <- plot1_data %>%
  group_by(word, span_group) %>%
  summarise(mean_TEPR = mean(TEPR, na.rm = TRUE),
            se_TEPR = sundry::se(TEPR))

# Rename variable for legend
plot2data %<>% 
  rename("WMC" = `span_group`)

plot2 <- ggplot(plot2data, aes(x = word, y = mean_TEPR)) +
    geom_ribbon(aes(ymin = mean_TEPR - 1.96*se_TEPR, 
                    ymax = mean_TEPR + 1.96*se_TEPR,
                    fill = WMC),
                    alpha = 0.4) +
    scale_fill_carto_d(palette = "Burg") +
    theme_minimal() +
    # Left-align caption
    theme(plot.caption = element_text(hjust = 0)) +
    # Change labels
    labs(caption = "Figure 2. Pupillary response across serial positions for low working memory capacity (WMC) individuals 
(n = 31), medium WMC individuals (n = 69), and high WMC individuals (n = 33).",
           y = "Mean Pupil Diameter (mm)",
           x = "Serial position",
           colour = "WMC") +
   # Relabel x axis values to make more sense to reader
   scale_x_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
                      labels = c("1", "2", "3", "4", "5", 
                                 "6", "7", "8", "9", "10")) 

plot2 + bbg_darktheme

Plot 3

Now I will attempt to plot pupil diameter as a function of serial position (broken down into Primacy (words 1–3), Mid (words 4–7), and Recency (words 8–10)) and bin (time across the 3 second study phase for each word) based on one’s WMC.

  • Fig. 6 in Miller, Gross, & Unsworth (2019)
    • Identification of the intended audience: Scientific community
    • The intended message to be communicated: This figure essentially conveys the same information as the figure above. For high WMC individuals, pupil dilation continues to gradually increase throughout the encoding period for all serial positions, with primacy items (the first few words presented during list presentation; words 1-3) displaying smaller dilations than mid (words 4–7) and recency items (the last few words presented during list presentation; words 8–10). Conversely, low WMC individuals show moderate increases in dilation that appear to plateau near the middle of the encoding period. Moreover, pupil dilation appears to be largest for primacy items and smallest for recency items, despite a gradual increase in dilation for recency items.
# Converting word # to factors
plot1_data$word <- as.factor(plot1_data$word)

# Breaking down words into primacy, mid, and recency items
plot3_data <- plot1_data %>% 
  mutate(word = recode(word, '1' = "Primacy Items",
                             '2' = "Primacy Items",
                             '3' = "Primacy Items",
                             '4' = "Mid Items",
                             '5' = "Mid Items", 
                             '6' = "Mid Items",
                             '7' = "Mid Items",
                             '8' = "Recency Items",
                             '9' = "Recency Items",
                            '10' = "Recency Items"))

plot3_data %<>%
  group_by(word, bin, span_group) %>%
  summarise(mean_TEPR = mean(TEPR, na.rm = TRUE),
            se_TEPR = sundry::se(TEPR))

plot3 <- ggplot(plot3_data, aes(x = bin, y = mean_TEPR, colour = span_group)) +
      geom_point(size = 0.8) +
      # Generate outcome draws from a fitted model
      stat_smooth_draws(times = 10,
                        aes(group = interaction(stat(.draw), colour)),
                        size = 0.8) +
      scale_color_carto_d(palette = "Burg") +
      # Create seperate plots for Primacy, Mid, and Recency Items
      facet_wrap(~word) +
      # Specifying sampled draws in addition to the animated lines
      transition_states(stat(.draw), 1, 2) +
      enter_fade() + exit_fade() +
      shadow_mark(future = TRUE, size = 0.25, color = "gray50", alpha = 1/4) +
      theme_minimal() +
      # Rotate x axis values so they are angled; center subtitle
      # Left-align caption
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            plot.caption = element_text(hjust = 0),
            plot.subtitle = element_text(face = "bold", hjust = 0.5)) +
      # Change labels
      labs(caption = "Figure 3. Pupil diameter as a function of serial position and time across encoding period for low WMC (n = 31), medium WMC 
(n = 69), and high WMC (n = 33) individuals. Serial position was broken down into Primacy (words 1–3), Mid (words 4–7), 
and Recency (words 8–10) for graphical purposes only.",
           y = "Mean Pupil Diameter (mm)",
           x = "Time (ms)",
           colour = "WMC") +
      # Adjust/Relabel x axis values to make more sense to reader
      scale_x_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14),
                         labels = c("0", "400", "800", "1,200", 
                                    "1,600", "2,000", "2,400","2,800"),
                         limits = c(0, NA)) +
      # Adjust/Relabel y axis values to make more sense to reader
      scale_y_continuous(breaks = c(-0.10, -0.05, 0.00, 0.05, 0.10, 0.15),
                         label = c("-0.10", "-0.05", "0.00", 
                                   "0.05", "0.10", "0.15"),
                         limits = c(-0.10, 0.15))

plot3 + bbg_darktheme

Above I faceted by serial position (primacy, mid, recency). In Miller et al. (2019), I actually faceted by WMC (low, mid, high). I honestly don’t know which method I prefer. For comparision sake, let’s try to reproduce the plot faceting by WMC:

  • Remember, the point this graph is trying to make is that when instructed to study a list of words for a later test, two factors influence the trajectory of pupil dilation across the study phase: (1) one’s WMC and (2) serial position. For high WMC individuals, pupil dilation continues to gradually increase throughout the encoding period for all serial positions, with primacy items (the first few words presented during list presentation; words 1-3) displaying smaller dilations than mid (words 4–7) and recency items (the last few words presented during list presentation; words 8–10). Conversely, low WMC individuals show moderate increases in dilation that appear to plateau near the middle of the encoding period. Moreover, pupil dilation appears to be largest for primacy items and smallest for recency items, despite a gradual increase in dilation for recency items.
# Specify factor levels
plot3_data$word <- factor(plot3_data$word, 
                                levels = c("Primacy Items", 
                                           "Mid Items", 
                                           "Recency Items"))

# Rename variables to enhance clarity
plot3_data %<>% 
  mutate(span_group = recode(span_group, 
                             'Low' = "Low WMC",
                             'Medium' = "Medium WMC",
                             'High' = "High WMC"))

plot3.2 <- ggplot(plot3_data, aes(x = bin, y = mean_TEPR, colour = word)) +
      geom_point(size = 0.8) +
      # Generate outcome draws from a fitted model
      stat_smooth_draws(times = 10,
                        aes(group = interaction(stat(.draw), colour)),
                        size = 0.8) +
      scale_color_carto_d(palette = "Burg") +
      # Create seperate plots for people with low, mid, and high WMC
      facet_wrap(~span_group) +
      # Specifying sampled draws in addition to the animated lines
      transition_states(stat(.draw), 1, 2) +
      enter_fade() + exit_fade() +
      shadow_mark(future = TRUE, size = 0.25, color = "gray50", alpha = 1/4) +
      theme_minimal() +
      # Rotate x axis values so they are angled; center subtitle
      # Left-align caption
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            plot.caption = element_text(hjust = 0),
            plot.subtitle = element_text(face = "bold", hjust = 0.5)) +
      # Change labels
      labs(caption = "Figure 3. Pupil diameter as a function of serial position and time across encoding period for low WMC (n = 31), medium WMC 
(n = 69), and high WMC (n = 33) individuals. Serial position was broken down into Primacy (words 1–3), Mid (words 4–7), 
and Recency (words 8–10) for graphical purposes only.",
           y = "Mean Pupil Diameter (mm)",
           x = "Time (ms)",
           colour = "Serial Position") +
      # Adjust/Relabel x axis values to make more sense to reader
      scale_x_continuous(breaks = c(0, 2, 4, 6, 8, 10, 12, 14),
                         labels = c("0", "400", "800", "1,200", 
                                    "1,600", "2,000", "2,400","2,800"),
                         limits = c(0, NA)) +
      # Adjust/Relabel y axis values to make more sense to reader
      scale_y_continuous(breaks = c(-0.10, -0.05, 0.00, 0.05, 0.10, 0.15),
                         label = c("-0.10", "-0.05", "0.00", 
                                   "0.05", "0.10", "0.15"),
                         limits = c(-0.10, 0.15))

plot3.2 + bbg_darktheme

Plot 4

Here I attempt to plot relation between recall accuracy and strategy type.

  • Identification of the intended audience: General public
  • The intended message to be communicated: Strategies that rely on more elaborative mental processes are associated with better memory performance
# Select variables of interest
strategy_data <- data %>%
  select(-sp1_acc:-sp10_acc,
         -ospan:-span_group,
         -primacy_recall:-ebin15w10pt4_mean) %>%
  gather(key = strat_type, value = response, passive_read_strat:other_strat)

# Filter out NAs, and convert strategy type and score to factors
strategy_data %<>%
  filter(response != "NA") %>%
  mutate(strat_type = as.factor(strat_type),
         response = as.factor(response)) 

#levels(as.factor(strategy_data$strat_type))

# Recode variables for graph
strategy_data %<>%
  mutate(strat_type = recode(strat_type,
                             "grouping_strat" = "Grouping",
                             "imagery_strat" = "Imagery",
                             "other_strat" = "Other",
                             "passive_read_strat" = "Passive Reading",
                             "rehearsal_strat" = "Rote Rehearsal",
                             "sentence_gen_strat" = "Sentence Generation")) %>%
  group_by(strat_type, response) %>%
  summarise(mean_acc = mean(accuracy_mean, na.rm = TRUE),
            se_acc = sundry::se(accuracy_mean))

# Specify factor levels
# Effective strategies = imagery, sentence generation, and grouping
# Ineffective strategies = rehearsal and passive reading
strategy_data$strat_type <- factor(strategy_data$strat_type, 
                                levels = c("Imagery", 
                                           "Sentence Generation", 
                                           "Grouping",
                                           "Rote Rehearsal", 
                                           "Passive Reading", 
                                           "Other"))

plot4 <- strategy_data %>%
  #filter out other and grouping strategy
  filter(strat_type != "Other" & strat_type != "Grouping") %>%
  ggplot(aes(response, mean_acc, fill = response)) +
      geom_col(width = 0.60, 
               alpha = 0.6) +
      geom_errorbar(aes(ymin = mean_acc + qnorm(0.025)*se_acc, 
                          ymax = mean_acc + qnorm(0.975)*se_acc),
                          color = "gray40",
                          width = 0.4, 
                          size = 0.8) +
      # Print accuracy associated with each condition
      geom_text(aes(response, mean_acc, label = paste0(round(mean_acc*100), "%")),
                nudge_y = 0.15, # Specifies how high above bar text appears
                size = 3,
                color = "gray80") +
      # Provide seperate graphs for each strategy
      facet_wrap(~strat_type) +
      scale_fill_carto_d(palette = "Burg") +
      theme_minimal() +
      # Delete legend and left-align caption
      theme(legend.position="none",
            plot.caption = element_text(hjust = 0)) +
      #Modify labels
      labs(title = "Recall Accuracy as a Function of Strategy Type and Use of Strategy",
               y = "Mean Recall Accuracy",
               x = "",
               caption = "'No' represents individuals who did not report using given strategy, whereas 'Yes' represents whose who used said strategy. 
Note that performance is actually better when people report not using a normatively ineffective strategy (e.g., rote rehearsal 
or passive reading) than when they report using these strategies.") +
      # Rename labels on x-axis
      scale_x_discrete(breaks = c(0, 1),
                       labels = c("No", "Yes")) +
      # Modify names/range of y-axis 
      scale_y_continuous(breaks = c(0, 0.2, 0.4, 0.6, 0.8),
                         labels = c("0%", "20%", "40%", "60%", "80%"),
                         limits = c(0, 0.8))

# Applying my theme to plot
plot4 + bbg_darktheme